MacHack 1998/MacHack 1998.toast/The Hacks!/The Crash Manager/"source"/main.p

Text File | 1998-06-20 | 8.0 KB | 377 lines | [TEXT/CWIE]

unit main;

interface

procedure DoMainLoop;

implementation

uses
    globals,
    Events,
    Windows,
    ToolUtils,
    Devices,
    AppleEvents,
    Appearance,
    Resources,
    Dialogs,
    cwindow,
    thebigpicture;

function IsDeep(w:WindowPtr):boolean;
begin
    IsDeep:=true;
end;

procedure Blit(p:PicHandle;r:Rect;w:WindowPtr);
var
    err:OSErr;
    theGWorld:GWorldPtr;
    lockFlag:boolean;
    savePort:CGrafPtr;
    saveDevice:GDHandle;
begin
    err:=NewGWorld(theGWorld,8,r,nil,nil,0);
    lockFlag:=LockPixels(GetGWorldPixMap(theGWorld));
    GetGWorld(savePort,saveDevice);
    SetGWorld(theGWorld,nil);
    DrawPicture(PicHandle(p),r);
    SetGWorld(savePort,saveDevice);
    CopyBits(GrafPtr(theGWorld)^.portBits,
                        GrafPtr(w)^.portBits,
                        r,
                        r,
                        srcCopy,
                        nil);
    DisposeGWorld(theGWorld);
end;

procedure MaskBlit(p,m:PicHandle;r:Rect;w:WindowPtr);
var
    err:OSErr;
    pictGWorld,maskGWorld:GWorldPtr;
    savePort:CGrafPtr;
    saveDevice:GDHandle;
begin
    EraseRect(r);
    err:=NewGWorld(pictGWorld,32,r,nil,nil,0);
    err:=NewGWorld(maskGWorld,32,r,nil,nil,0);
    GetGWorld(savePort,saveDevice);
    SetGWorld(pictGWorld,nil);
    DrawPicture(PicHandle(p),r);
    SetGWorld(maskGWorld,nil);
    DrawPicture(PicHandle(m),r);
    SetGWorld(savePort,saveDevice);
    ForeColor(blackColor);
    BackColor(whiteColor);
    CopyDeepMask(GrafPtr(pictGWorld)^.portBits,
                    GrafPtr(maskGWorld)^.portBits,
                    GrafPtr(w)^.portBits,
                    r,
                    r,
                    r,
                    srcCopy,
                    nil);
    DisposeGWorld(maskGWorld);
    DisposeGWorld(pictGWorld);
end;

procedure DoPICTProc(theWindow:WindowPtr;itemNo:integer);
var
    pict,mask:Handle;
    theRect:Rect;
    theType:integer;
    theControl:Handle;
begin
    GetDialogItem(DialogPtr(theWindow),itemNo,theType,theControl,theRect);
    if IsDeep(theWindow) then begin
        case itemNo of
            ABOUT_TITLE_UI:begin
                pict:=GetResource('PICT',ABOUT_TITLE_DEEP_ID);
                Blit(PicHandle(pict),theRect,theWindow);
                ReleaseResource(pict);
            end;
            COPYR_UI:begin
                pict:=GetResource('PICT',COPYR_DEEP_ID);
                Blit(PicHandle(pict),theRect,theWindow);
                ReleaseResource(pict);
            end;
            ABOUT_ICON_UI:begin
                pict:=GetResource('PICT',ABOUT_ICON_DEEP_ID);
                mask:=GetResource('PICT',ABOUT_ICON_MASK_ID);
                MaskBlit(PicHandle(pict),PicHandle(mask),theRect,theWindow);
                ReleaseResource(mask);
                ReleaseResource(pict);
            end;
        end;
    end else begin
        case itemNo of
            ABOUT_TITLE_UI:begin
                pict:=GetResource('PICT',ABOUT_TITLE_BW_ID);
                DrawPicture(PicHandle(pict),theRect);
                ReleaseResource(pict);
            end;
            COPYR_UI:begin
                pict:=GetResource('PICT',COPYR_BW_ID);
                DrawPicture(PicHandle(pict),theRect);
                ReleaseResource(pict);
            end;
            ABOUT_ICON_UI:begin
                pict:=GetResource('PICT',ABOUT_ICON_BW_ID);
                DrawPicture(PicHandle(pict),theRect);
                ReleaseResource(pict);
            end;
        end;
    end;
end;

procedure DoAboutBox;
var
    aboutBox:DialogPtr;
    thePICTProc:UserItemUPP;
    theType,theItem:integer;
    junkHandle:Handle;
    theBox:Rect;
    doneDialog:boolean;
    theErr:OSErr;
begin
    aboutBox:=GetNewDialog(ABOUT_BOX_ID,nil,WindowPtr(-1));
    thePICTProc:=NewUserItemProc(@DoPICTProc);
    GetDialogItem(aboutBox,ABOUT_ICON_UI,theType,junkHandle,theBox);
    SetDialogItem(aboutBox,ABOUT_ICON_UI,theType,Handle(thePICTProc),theBox);
    GetDialogItem(aboutBox,COPYR_UI,theType,junkHandle,theBox);
    SetDialogItem(aboutBox,COPYR_UI,theType,Handle(thePICTProc),theBox);
    GetDialogItem(aboutBox,ABOUT_TITLE_UI,theType,junkHandle,theBox);
    SetDialogItem(aboutBox,ABOUT_TITLE_UI,theType,Handle(thePICTProc),theBox);
    theErr:=SetDialogDefaultItem(aboutBox,OK_BUTTON);
    ShowWindow(aboutBox);
    doneDialog:=false;
    while not doneDialog do begin
        ModalDialog(nil,theItem);
        case theItem of
            OK_BUTTON: begin
                doneDialog:=true;
            end;
        end;
    end;
    DisposeRoutineDescriptor(thePICTProc);
    DisposeDialog(aboutBox);
end;

procedure DoAppleMenu(choice:integer);
var
    accName: Str255;
    accNumber:integer;
begin
    case choice of
        APPLE_ABOUT:
            DoAboutBox;
        otherwise begin
            GetMenuItemText(gAppleMenuH, choice, accName);
            accNumber := OpenDeskAcc(accName);
        end;
    end;
end;

procedure DoFileMenu(choice:integer);
begin
    case choice of
        FILE_QUIT,FILE_CLOSE:
            gQuitNow:=true;
    end;

end;

procedure DoEditMenu(choice:integer);
begin
    case choice of
        EDIT_CUT:
            ;
        EDIT_COPY:
            ;
        EDIT_PASTE:
            ;
        EDIT_CLEAR:
            ;
        EDIT_UNDO:
            ;
    end;
end;

procedure HandleMenuChoice (menuChoice: longint);
var
    theMenu, theMenuItem: integer;
begin
    if menuChoice <> 0 then begin
        theMenu := HiWord(menuChoice);
        theMenuItem := LoWord(menuChoice);
        case theMenu of
            APPLE_MENU:
                DoAppleMenu(theMenuItem);
            FILE_MENU:
                DoFileMenu(theMenuItem);
            EDIT_MENU:
                DoEditMenu(theMenuItem);
        end;
    end;
end;

procedure DoContentClick(p:Point;w:WindowPtr);
var
    thePart:integer;
    theControl:ControlHandle;
begin
    GlobalToLocal(p);
    thePart:=FindControl(p,w,theControl);
    if thePart <> 0 then begin
        thePart:=TrackControl(theControl,p,nil);
        if thePart <>0 then begin
            if theControl=gBombButton then begin
                gPaneState:=PANE_BOMB;
                SetControlValue(gClusterButton,0);
                DrawMainPane(kThemeStateActive);
            end;
            if theControl=gClusterButton then begin
                gPaneState:=PANE_CLUSTER;
                SetControlValue(gBombButton,0);
                DrawMainPane(kThemeStateActive);
            end;
            if theControl=gTypePopUp then begin
                DrawSmallPic;
            end;
            if theControl=gPreviewButton then begin
                DrawBigPicture;
            end;
        end;
    end;
end;

procedure HandleMouseDown;
var
    thePart: integer;
    whichWindow: WindowPtr;
    menuChoice: longint;
begin
    thePart := FindWindow(gEr.where, whichWindow);
    case thePart of
        inMenuBar:  begin
            menuChoice := MenuSelect(gEr.where);
            HandleMenuChoice(menuChoice);
            HiliteMenu(0);
            DrawMenuBar;
        end;
        inSysWindow:
            SystemClick(gEr, whichWindow);
        inDrag:
            DragWindow(whichWindow, gEr.where, qd.screenBits.bounds);
        inContent:
            DoContentClick(gEr.where,whichWindow);
        inGoAway:if TrackGoAway(whichWindow,gEr.where) then
            gQuitNow:=true;
    end;
end;

procedure DoHighLevelEvent (event: EventRecord);
{This is pretty lame here since I'm only implementing the core events.}
var
    myErr: OSErr;
begin
    myErr := AEProcessAppleEvent(event);
end;

function IsDAWindow (whichWindow: WindowPtr): boolean;
{Stupid routine to determine if a window belongs to us or a desk accessory.    }
begin
    if whichWindow = nil then
        IsDAWindow := false
    else
        IsDAWindow := (WindowPeek(whichWindow)^.windowKind < 0);
end;

procedure DeactivateControls;
var
    err:OSErr;
begin
    err:=DeactivateControl(gBombButton);
    err:=DeactivateControl(gClusterButton);
    err:=DeactivateControl(gTypePopUp);
    err:=DeactivateControl(gPreviewButton);
    err:=DeactivateControl(gFreqPopUp);
end;

procedure ActivateControls;
var
    err:OSErr;
begin
    err:=ActivateControl(gBombButton);
    err:=ActivateControl(gClusterButton);
    err:=ActivateControl(gTypePopUp);
    err:=ActivateControl(gPreviewButton);
    err:=ActivateControl(gFreqPopUp);
end;

procedure WNE;
var
    importantEvent:boolean;
    oldPort:GrafPtr;
begin
    importantEvent:=WaitNextEvent(everyEvent,gEr,EVENT_DELAY,nil);
    if importantEvent then begin
        case gEr.what of
            mouseDown:
                HandleMouseDown;
            mouseUp:
                ;
            kHighLevelEvent:
                DoHighLevelEvent(gEr);
            updateEvt:begin
                if not IsDAWindow(WindowPtr(gEr.message)) then begin
                    GetPort(oldPort);
                    SetPort(WindowPtr(gEr.message));
                    BeginUpdate(WindowPtr(gEr.message));
                    if WindowPtr(gEr.message)=gMainWindow then begin
                        if gInForeground=true then
                            DrawWindow(kThemeStateActive)
                        else
                            DrawWindow(kThemeStateDisabled);
                    end;
                    EndUpdate(WindowPtr(gEr.message));
                    SetPort(oldPort);
                end;
            end;
            osEvt:begin
                if BTST(gEr.message,0) then begin
                    SetCursor(qd.arrow);
                    gInForeground:=true;
                    DrawWindow(kThemeStateActive);
                    ActivateControls;
                end else begin
                    gInForeground:=false;
                    DrawWindow(kThemeStateDisabled);
                    DeactivateControls;
                end;
                DrawControls(gMainWindow);
            end;
            activateEvt,diskEvt:
                ;
            keyDown:begin
                HandleMenuChoice(MenuEvent(gEr));
                HiliteMenu(0);
            end;
            keyUp:
                ;
        end;
    end;
end;


procedure DoMainLoop;
begin
    while not gQuitNow do begin
        WNE;
    end;
end;


end.